perm filename FILLER.F4[CMS,LCS]1 blob sn#098723 filedate 1974-04-20 generic text, type T, neo UTF8
     

00100	C  Q AND R  ARE X,Y COORDS.  NE(1)=WDCNT. OTHER NE'S HAVE 3
00200	C   FOR INVIS. VECTORS.   M=VERTICAL SCAN LINES
00300		SUBROUTINE FILLER(Q,R,NE,M)
00400		DIMENSION Q(1),R(1),NE(1)
00500		KK=NE(1)
00600		KJ=2
00700		DO 4 K=2,KK
00800		IF(NE(K).NE.3)GO TO 11
00900		NE(K)=KJ
01000		KJ=K+1
01100		GO TO 4
01200	11	NE(K)=0
01300	4	CONTINUE
01400		DO 12 K=1,KK
01500		Q(K)=IFIX(Q(K))
01600	12	R(K)=IFIX(R(K))
01700		NE(KK+1)=KJ
01800	C  FINDS JUMPS
01900		DO 2 J=2,KK
02000		IF(NE(J).GT.0.OR.Q(J).EQ.Q(J-1))GO TO 2
02100	C  SKIPS VERTICAL LINES
02200		X=HALF(Q,J)+.00001
02300	C  MIDPOINT OF LINE
02400		ALT=HALF(R,J)
02500	C  THE ALTITUDE
02600		KJ=0
02700	
02800	100	DO 3 L=2,KK
02900		IF(L.EQ.J.OR.NE(L).GT.0)GO TO 3
03000	C  NEXT FINDS LINE OVERLAP
03100		IF(MISS(L,X,Q,R))GO TO 3
03200	C  NEXT FINDS ALT. OF CROSSING
03300	40	Y=HGHT(L,X,Q,R)
03400		IF(Y.LT.ALT)KJ=KJ+1
03500	3	CONTINUE
03600		IF(MOD(KJ,2).EQ.0)GO TO 2
03700	C  NEXT IF FOUND A LINE TO DRAW LINES DOWN FROM.
03800		NE(J)=-1
03900		JA=3
04000		KJ=M
04100		ALT=.0001
04200		N=Q(J)
04300		L=Q(J-1)
04400		IF(N.LT.L)GO TO 33
04500		KJ=-KJ
04600		ALT=-ALT
04700	33	X=-1
04800	17	DO 6 K=N,L,KJ
04900		RK=K
05000		XK=RK
05100		IF(K.EQ.L)ALT=-ALT
05200	C  NO SHIFT AT LAST POSITION
05300		RK=RK+ALT
05400		Y=HGHT(J,RK,Q,R)
05500		IF(X)CALL LINES(XK,Y,JA,M)
05600		JA=2
05700		H=-10000
05800	
05900	18	DO 7 I=2,KK
06000		IF(NE(I).NE.0)GO TO 7
06100	C  SKIP IF SAME LINE.
06200		IF(MISS(I,RK,Q,R))GO TO 7
06300	C  TRY NEXT POINT IF IT HIT A -1 LINE.
06400	9	B=HGHT(I,RK,Q,R)
06500		IF(B.GT.Y)GO TO 7
06600		IF(B.LE.H)GO TO 7
06700		H=B
06800	C  FOUND HIGHEST NEW POINT
06900	7	CONTINUE
07000		IF(H.EQ.Y)GO TO 31
07100	C  WIPES OUT THIS LINE SEG.
07200		IF(H.NE.-10000)GO TO 31
07300		X=1
07400		GO TO 6
07500	31	CALL LINES(XK,H,2,M)
07600		IF(X.GT.0)CALL LINES(XK,Y,JA,M)
07700		X=-X
07800	6	CONTINUE
07900	2	CONTINUE
08000		IF(M.LT.6)CALL PLOT(0,0,3)
08100		RETURN
08200		END
08300		
08400		FUNCTION HGHT(J,A,Q,R)
08500		DIMENSION Q(1),R(1)
08600		B=R(J-1)
08700		D=Q(J-1)
08800		F=Q(J)
08900		HGHT=((R(J)-B)*(A-D))/(F-D)+B
09000		IF(F.EQ.D)HGHT=B
09100		RETURN
09200		END
09300	
09400		FUNCTION MISS(J,A,Q,R)
09500		DIMENSION Q(1),R(1)
09600		B=Q(J)
09700		C=Q(J-1)
09800		MISS=-1
09900		IF((A.LT.C.AND.A.GT.B).OR.(A.LT.B.AND.A.GT.C))MISS=0
10000		RETURN
10100		END
10200	C  MISS=-1, HIT=0, POINT=1
10300	
10400		FUNCTION HALF(A,J)
10500		DIMENSION A(1)
10600		HALF=(A(J-1)-A(J))/2.+A(J)
10700		RETURN
10800		END
10900	
11000		SUBROUTINE LINES(A,B,J,I)
11100		M=A
11200		N=B
11300		IF(IABS(I).LT.6)GO TO 2
11400		IF(J.EQ.3)GO TO 1
11500		CALL AVECT(M,N)
11600		RETURN
11700	1	CALL AIVECT(M,N)
11800		RETURN
11900	2	CALL PLOT(M,N,J)
12000		RETURN
12100		END